home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / lapack / zlanhe.f < prev    next >
Text File  |  1997-06-25  |  6KB  |  189 lines
  1.       DOUBLE PRECISION FUNCTION ZLANHE( NORM, UPLO, N, A, LDA, WORK )
  2. *
  3. *  -- LAPACK auxiliary routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     October 31, 1992
  7. *
  8. *     .. Scalar Arguments ..
  9.       CHARACTER          NORM, UPLO
  10.       INTEGER            LDA, N
  11. *     ..
  12. *     .. Array Arguments ..
  13.       DOUBLE PRECISION   WORK( * )
  14.       COMPLEX*16         A( LDA, * )
  15. *     ..
  16. *
  17. *  Purpose
  18. *  =======
  19. *
  20. *  ZLANHE  returns the value of the one norm,  or the Frobenius norm, or
  21. *  the  infinity norm,  or the  element of  largest absolute value  of a
  22. *  complex hermitian matrix A.
  23. *
  24. *  Description
  25. *  ===========
  26. *
  27. *  ZLANHE returns the value
  28. *
  29. *     ZLANHE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
  30. *              (
  31. *              ( norm1(A),         NORM = '1', 'O' or 'o'
  32. *              (
  33. *              ( normI(A),         NORM = 'I' or 'i'
  34. *              (
  35. *              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
  36. *
  37. *  where  norm1  denotes the  one norm of a matrix (maximum column sum),
  38. *  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
  39. *  normF  denotes the  Frobenius norm of a matrix (square root of sum of
  40. *  squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
  41. *
  42. *  Arguments
  43. *  =========
  44. *
  45. *  NORM    (input) CHARACTER*1
  46. *          Specifies the value to be returned in ZLANHE as described
  47. *          above.
  48. *
  49. *  UPLO    (input) CHARACTER*1
  50. *          Specifies whether the upper or lower triangular part of the
  51. *          hermitian matrix A is to be referenced.
  52. *          = 'U':  Upper triangular part of A is referenced
  53. *          = 'L':  Lower triangular part of A is referenced
  54. *
  55. *  N       (input) INTEGER
  56. *          The order of the matrix A.  N >= 0.  When N = 0, ZLANHE is
  57. *          set to zero.
  58. *
  59. *  A       (input) COMPLEX*16 array, dimension (LDA,N)
  60. *          The hermitian matrix A.  If UPLO = 'U', the leading n by n
  61. *          upper triangular part of A contains the upper triangular part
  62. *          of the matrix A, and the strictly lower triangular part of A
  63. *          is not referenced.  If UPLO = 'L', the leading n by n lower
  64. *          triangular part of A contains the lower triangular part of
  65. *          the matrix A, and the strictly upper triangular part of A is
  66. *          not referenced. Note that the imaginary parts of the diagonal
  67. *          elements need not be set and are assumed to be zero.
  68. *
  69. *  LDA     (input) INTEGER
  70. *          The leading dimension of the array A.  LDA >= max(N,1).
  71. *
  72. *  WORK    (workspace) DOUBLE PRECISION array, dimension (LWORK),
  73. *          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
  74. *          WORK is not referenced.
  75. *
  76. * =====================================================================
  77. *
  78. *     .. Parameters ..
  79.       DOUBLE PRECISION   ONE, ZERO
  80.       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  81. *     ..
  82. *     .. Local Scalars ..
  83.       INTEGER            I, J
  84.       DOUBLE PRECISION   ABSA, SCALE, SUM, VALUE
  85. *     ..
  86. *     .. External Functions ..
  87.       LOGICAL            LSAME
  88.       EXTERNAL           LSAME
  89. *     ..
  90. *     .. External Subroutines ..
  91.       EXTERNAL           ZLASSQ
  92. *     ..
  93. *     .. Intrinsic Functions ..
  94.       INTRINSIC          ABS, DBLE, MAX, SQRT
  95. *     ..
  96. *     .. Executable Statements ..
  97. *
  98.       IF( N.EQ.0 ) THEN
  99.          VALUE = ZERO
  100.       ELSE IF( LSAME( NORM, 'M' ) ) THEN
  101. *
  102. *        Find max(abs(A(i,j))).
  103. *
  104.          VALUE = ZERO
  105.          IF( LSAME( UPLO, 'U' ) ) THEN
  106.             DO 20 J = 1, N
  107.                DO 10 I = 1, J - 1
  108.                   VALUE = MAX( VALUE, ABS( A( I, J ) ) )
  109.    10          CONTINUE
  110.                VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) )
  111.    20       CONTINUE
  112.          ELSE
  113.             DO 40 J = 1, N
  114.                VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) )
  115.                DO 30 I = J + 1, N
  116.                   VALUE = MAX( VALUE, ABS( A( I, J ) ) )
  117.    30          CONTINUE
  118.    40       CONTINUE
  119.          END IF
  120.       ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
  121.      $         ( NORM.EQ.'1' ) ) THEN
  122. *
  123. *        Find normI(A) ( = norm1(A), since A is hermitian).
  124. *
  125.          VALUE = ZERO
  126.          IF( LSAME( UPLO, 'U' ) ) THEN
  127.             DO 60 J = 1, N
  128.                SUM = ZERO
  129.                DO 50 I = 1, J - 1
  130.                   ABSA = ABS( A( I, J ) )
  131.                   SUM = SUM + ABSA
  132.                   WORK( I ) = WORK( I ) + ABSA
  133.    50          CONTINUE
  134.                WORK( J ) = SUM + ABS( DBLE( A( J, J ) ) )
  135.    60       CONTINUE
  136.             DO 70 I = 1, N
  137.                VALUE = MAX( VALUE, WORK( I ) )
  138.    70       CONTINUE
  139.          ELSE
  140.             DO 80 I = 1, N
  141.                WORK( I ) = ZERO
  142.    80       CONTINUE
  143.             DO 100 J = 1, N
  144.                SUM = WORK( J ) + ABS( DBLE( A( J, J ) ) )
  145.                DO 90 I = J + 1, N
  146.                   ABSA = ABS( A( I, J ) )
  147.                   SUM = SUM + ABSA
  148.                   WORK( I ) = WORK( I ) + ABSA
  149.    90          CONTINUE
  150.                VALUE = MAX( VALUE, SUM )
  151.   100       CONTINUE
  152.          END IF
  153.       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
  154. *
  155. *        Find normF(A).
  156. *
  157.          SCALE = ZERO
  158.          SUM = ONE
  159.          IF( LSAME( UPLO, 'U' ) ) THEN
  160.             DO 110 J = 2, N
  161.                CALL ZLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
  162.   110       CONTINUE
  163.          ELSE
  164.             DO 120 J = 1, N - 1
  165.                CALL ZLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
  166.   120       CONTINUE
  167.          END IF
  168.          SUM = 2*SUM
  169.          DO 130 I = 1, N
  170.             IF( DBLE( A( I, I ) ).NE.ZERO ) THEN
  171.                ABSA = ABS( DBLE( A( I, I ) ) )
  172.                IF( SCALE.LT.ABSA ) THEN
  173.                   SUM = ONE + SUM*( SCALE / ABSA )**2
  174.                   SCALE = ABSA
  175.                ELSE
  176.                   SUM = SUM + ( ABSA / SCALE )**2
  177.                END IF
  178.             END IF
  179.   130    CONTINUE
  180.          VALUE = SCALE*SQRT( SUM )
  181.       END IF
  182. *
  183.       ZLANHE = VALUE
  184.       RETURN
  185. *
  186. *     End of ZLANHE
  187. *
  188.       END
  189.